home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / PRGMMING / M2PROTOS.ZIP / QCBPLUS.MOD < prev    next >
Encoding:
Modula Implementation  |  1993-12-12  |  41.4 KB  |  1,280 lines
  1. (*# call(o_a_copy => off) *)
  2. (*%F _fcall *)
  3. (*# call(seg_name => null) *)
  4. (*%E *)
  5. (*# module(implementation=>on) *)
  6. (*# data(seg_name => null) *)
  7. (*# data(const_assign => on) *)
  8. IMPLEMENTATION MODULE QCbplus;
  9.  
  10.                      (* This JPI Modula-2 module is part of *)
  11.  
  12.                       (* QC -- a communications program *)
  13.                              (* by Carl Neiburger *)
  14.                               (* 169 N. 25th St.*)
  15.                           (* San Jose, Calif. 95116 *)
  16.  
  17.                          (* CompuServe No. 72336,2257 *)
  18.  
  19. FROM CRC IMPORT ChkProc, DoCRC, DoBCks;
  20. FROM Str IMPORT Append, CHARSET, CardToString, Concat, Length;
  21. FROM QCcomm IMPORT CommRdData, CommRdDataTest, CommWrStr, CommWrData,
  22.     ComTimedOut, ComAbort, etx, cr, dle, enq, etx, nak;
  23. FROM NFIO IMPORT Close, Create, EOF, Erase, File, Size, OK, Open, Exists,
  24.     PathStr, RdBin, Rename, SeekEOF, WrBin;
  25. FROM QCdisp IMPORT BPlus, DataBytes, DataLeft, DataRegisters, DisplayData,
  26.     AbortMsg, TotalBytes, Packets, QCDefPtr, ShowErrorType, StartDisplay,
  27.     ShowPacketSize, ShowTimeLeft, StopDisplay, IncrDataBytes, ShowFileName,
  28.     Errs, CloseError, CreateError, TimeoutMsg, WriteErrorMsg, StatusMessage,
  29.     OpenError, PromptForString, Yes, ShowTransferTime, PressKey, FlushLog,
  30.     ShowTransferType, UpdateData;
  31. FROM QCproto IMPORT ChoosePath;
  32. FROM UTIL IMPORT NUMSET, SBITSET, str5, str10, str11, str80;
  33. FROM Lib IMPORT Fill, Move, ScanR;
  34. FROM FioAsm IMPORT DiskFree, GetDrive;
  35. FROM RBvideo IMPORT Delay, WrStr;
  36. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  37. FROM Timer IMPORT StartTimer, ForTransfer, ForPacket;
  38. FROM QCshell IMPORT GifTempName, ShowSaveGif;
  39. FROM MiscAsm IMPORT HI;
  40.  
  41. CONST
  42.     MaxBufSize  = 1032;     (* Largest data block we can handle *)
  43.     MaxSA = 2;               (* Maximum number of waiting packets *)
  44.     AFailureMsg = 'AAborted by user';
  45. TYPE
  46.   QSArray = ARRAY [0..7] OF SHORTCARD;
  47.  
  48. TransParamRec = RECORD
  49.       WS : SHORTCARD; (* Window Send *)
  50.       WR : SHORTCARD; (* Window Receive  *)
  51.       BS : SHORTCARD; (* Block Size      *)
  52.       CM : BOOLEAN;   (* Check Method    *)
  53.       DQ : SHORTCARD; (* Old quote set   *)
  54.       xx : BYTE;      (* No transport layer here *)
  55.       QS : QSArray;   (* Quote Set *)
  56. (* The next 3 Parameters are FOR the B Plus File Transfer Application *)
  57.       DR : SHORTCARD; (* Download Recovery Option *)
  58.       UR : SHORTCARD; (* Upload Recovery Option *)
  59.       FI : SHORTCARD; (* File Information Option *)
  60. END;
  61.  
  62. TransParamPtr = POINTER TO TransParamRec;
  63.  
  64.     BPtr = POINTER TO ARRAY [0..MaxBufSize] OF SHORTCARD;
  65.  
  66.     BufRec = RECORD
  67.          seq : CARDINAL;    (* Packet's sequence number  *)
  68.          num : CARDINAL;    (* Number of bytes in packet *)
  69.          buf : BPtr;        (* Actual packet data *)
  70.     END;
  71.  
  72. VAR
  73.  
  74.   seqNum      : CARDINAL;      (* Current Sequence Number - init by TermENQ *)
  75.   checksum    : CARDINAL;      (* May hold CRC *)
  76.   chkInit     : CARDINAL;      (* Initial checksum or CRC *)
  77.   UpdChk      : ChkProc;       (* Do CRC or Checksum *)
  78.  
  79.   His : TransParamRec;  (* Initiator's Parameters *)
  80.   Our : TransParamRec;  (* Negotiated Parameters *)
  81.  
  82.   BPlusOn         : BOOLEAN;  (* TRUE if B Plus in effect *)
  83.   UseCRC          : BOOLEAN;  (* TRUE if CRC in effect *)
  84.   SpecialQuoting  : BOOLEAN;  (* TRUE to use SpecialQuoteSet *)
  85.   SpecialQuoteSet : QSArray;  (* User's specified Quote Set *)
  86.  
  87.   BufferSize      : CARDINAL; (* Our.BS * 4 *)
  88.   SAMax           : CARDINAL; (* 1 IF SA NOT enabled, ELSE MaxSA *)
  89.   SAErrors        : CARDINAL; (* # OF times SSendData called *)
  90.  
  91.   QuoteTable : ARRAY [0..255] OF SHORTCARD;   (* The quoting table *)
  92.  
  93.   FileType        : str10;    (* used to pass info to datadisp *)
  94.   MsgStr          : str80;    (* general purpose string *)
  95.   DataFile        : File;
  96.  
  97.   DefPtr         : TransParamPtr;
  98.  
  99. CONST
  100.   DQfull = QSArray(
  101.            0FFH, 0FFH, 0FFH, 0FFH,
  102.            0FFH, 0FFH, 0FFH, 0FFH
  103.           );
  104.   DQdefault = QSArray(
  105.           14H, 00H, 0D4H, 00H,   (* ETX ENQ DLE XON XOFF NAK *)
  106.           00H, 00H, 00H, 00H
  107.          );
  108.   DQminimal = QSArray(
  109.          14H, 00H, 0D4H, 00H,    (* ETX ENQ DLE XON XOFF NAK *)
  110.          00H, 00H, 00H, 00H
  111.         );
  112.   DQextended = QSArray(
  113.         14H, 00H, 0D4H, 00H,     (* ETX ENQ DLE XON XOFF NAK *)
  114.         00H, 00H, 50H, 00H      (* XON XOFF *)
  115.        );
  116.  
  117.   Def = TransParamRec(
  118.           (* WS *) 1,           (* I can Send 2 Packets ahead  *)
  119.           (* WR *) 1,           (* I can receive single Send-ahead  *)
  120.           (* BS *) 4,
  121.           (* CM *) TRUE,        (* I CAN handle CRC *)
  122.           (* DQ *) 2,           (* I need extended quote set *)
  123.                                 (* (including the `Tf' Packet *)
  124.           (* xx *) 0,
  125.           QSArray(DQextended),
  126.           (* DR *) 1,           (* I CAN handle Download Recovery *)
  127.           (* UR *) 0,           (* I CANNOT handle Upload Recovery *)
  128.           (* FI *) 1);          (* I can handle File Information *)
  129.  
  130.    FirstTPR = TransParamRec(
  131.           (* WS *) 0,           (* No send ahead *)
  132.           (* WR *) 0,           (* ditto *)
  133.           (* BS *) 4,
  134.           (* CM *) FALSE,       (* NO CRC *)
  135.           (* DQ *) 2,           (* I need extended quote set *)
  136.           (* xx *) 0,
  137.           QSArray(DQextended),
  138.           (* DR *) 0,           (* NO Download Recovery *)
  139.           (* UR *) 0,           (* NO Upload Recovery *)
  140.           (* FI *) 0);          (* NO File Information *)
  141.  
  142. PROCEDURE UpdateQuoteTable (QuoteSet : QSArray);
  143. (*   Sets the i-th entry OF QuoteTable to the necessary quoting character
  144.     according to the i-th bit of the supplied quote set.*)
  145. VAR
  146.   i, j, k : CARDINAL;
  147.   b, c : SHORTCARD;
  148.  
  149. BEGIN
  150.   k := 0;
  151.   c := 40H;
  152.   FOR i := 0 TO 7 DO
  153.       IF i = 4 THEN        (* Switch to upper control set *)
  154.           c := 60H;
  155.           k := 128;
  156.       END;
  157.       b := QuoteSet [i];
  158.       FOR j := 7 TO 0 BY -1 DO
  159.         IF j IN SBITSET(b) THEN
  160.               QuoteTable [k] := c
  161.         END;
  162.         INC(c);
  163.         INC(k)
  164.       END;
  165.     END;
  166. END UpdateQuoteTable ;
  167.  
  168. PROCEDURE QuoteThis (Value: SHORTCARD);
  169. (* Sets SpecialQuoting TRUE to use the special quote set. *)
  170. (* If Value = 0FFH, the special quote set is restored to default. *)
  171. VAR i : CARDINAL;
  172. BEGIN
  173.   IF Value IN NUMSET{00H..1FH,80H..9FH} THEN
  174.       IF Value > 1FH THEN
  175.           i := 4;
  176.           Value := Value MOD 20H
  177.       ELSE
  178.           i := 0
  179.       END;
  180.       INC(i, ORD(Value DIV 8));   (* = index into SpecialQuoteSet *)
  181.       INCL( SBITSET(SpecialQuoteSet[i]), 7 - ORD(Value MOD 8) );
  182.       SpecialQuoting := TRUE;
  183.   ELSIF Value = 0FFH THEN   (* Restore the Quote Set? *)
  184.       SpecialQuoteSet := DQextended;
  185.       SpecialQuoting := FALSE;
  186.   END;
  187. END QuoteThis;
  188.  
  189. PROCEDURE TermENQ;
  190. (* called when the terminal emulator receives an <ENQ> from the host.
  191.    It initializes for B Protocol and tells the host that we support B Plus. *)
  192. CONST TermEnqResp = CHR(dle) + '++' + CHR(dle) + '0';
  193. VAR cks : CARDINAL;
  194. BEGIN
  195.   seqNum     := 0;
  196.   BufferSize := 512;            (* default *)
  197.   Our        := FirstTPR;
  198.   BPlusOn    := FALSE;          (* NOT B Plus Protocol *)
  199.   UseCRC     := FALSE;          (* NOT CRC *)
  200.   chkInit    := 0;
  201.   UpdChk     := DoBCks;
  202.   SAMax      := 1;              (* Single Packet Send *)
  203.   SAErrors   := 0;              (* Reset counter *)
  204.  
  205.   Fill( ADR(QuoteTable), SIZE(QuoteTable), 0);
  206.   UpdateQuoteTable (DQextended);
  207.   cks := CommWrStr( TermEnqResp );
  208. END TermENQ;
  209.  
  210. PROCEDURE TermEscI (EscIResponse : ARRAY OF CHAR);
  211. (* called when <ESC><I> is received.
  212.   CompuServe now recognizes the string ",+xxxx" as the final field.
  213.   This provides a checksum (xxxx being the ASCII decimal representation of the
  214.   sum of all characters in the response string from # to +.  The checksum
  215.   eliminates the need for retransmission and comparison of the response. *)
  216.  
  217. VAR t : str5; cks : CARDINAL;
  218. BEGIN
  219.   cks :=  CommWrStr( EscIResponse ) + CommWrStr( ',+' );
  220.   CardToString( VAL(LONGCARD, cks ), t, 0, 0C );
  221.   cks := CommWrStr( t );
  222.   CommWrData (cr);
  223. END TermEscI;
  224.  
  225. PROCEDURE DleBSeen;
  226. (* called from the main program when <DLE> B is received. This calls
  227.   ReadPacket and then calls the appropriate routine to handle   the packet. *)
  228.  
  229. CONST MaxErrors   =  10;
  230.  
  231.   VAR
  232.     Len,                        (* used in decoding 'T' packet *)
  233.     RSize        : CARDINAL;    (* Bytes in receiver buffer *)
  234.     Ch           : SHORTCARD;   (* current character *)
  235.     SABuf : ARRAY[0..MaxSA] OF BufRec;
  236.     RBuf  : BPtr;
  237.  
  238.     PacketReceived,             (* True if a packet was received *)
  239.     Quoted       : BOOLEAN;     (* True if ctrl character was quoted *)
  240.  
  241.     SANextToACK  : CARDINAL;    (* Which SABuf is waiting for an ACK *)
  242.     SANextToFill : CARDINAL;    (* Which SABuf is ready for new data *)
  243.     SAWaiting    : CARDINAL;    (* Number of SABufs waiting for ACK *)
  244.     AbortRequest : BOOLEAN;     (* True if keyboard abort requested *)
  245.     Aborting     : BOOLEAN;     (* True if aborting the transfer *)
  246.     AbortCount   : CARDINAL;    (* Number of times checkAbort() returns TRUE *)
  247.     FatalAbort   : BOOLEAN;     (* True if AbortCount exceeds AbortMax *)
  248.  
  249.     FileName     : PathStr;     (* pathname *)
  250.     ResumeFlag   : BOOLEAN;     (* True if attempting a DOW resume *)
  251.     RFileSize,                  (* Size of file being received *)
  252.     FileLength   : LONGCARD;    (* for download resumption *)
  253.  
  254.  
  255. PROCEDURE SendQuotedByte (ch : BYTE );
  256. BEGIN
  257.   IF QuoteTable [ORD(ch)] <> 0 THEN
  258.       CommWrData (dle);
  259.       CommWrData (QuoteTable [ORD(ch)]);
  260.   ELSE
  261.       CommWrData (ch);
  262.   END
  263. END SendQuotedByte;
  264.  
  265. PROCEDURE SendACK;
  266. BEGIN
  267.   CommWrData (dle);
  268.   CommWrData ( SHORTCARD(seqNum) + SHORTCARD('0'));
  269. END SendACK;
  270.  
  271. PROCEDURE SendNAK;
  272. BEGIN
  273.   INC(DataRegisters[TRUE, Errs]);
  274.   DisplayData( Errs, TRUE );
  275.   CommWrData (nak);
  276. END SendNAK;
  277.  
  278. PROCEDURE SendENQ;
  279. BEGIN
  280.   CommWrData (enq);
  281.   CommWrData (enq);
  282. END SendENQ;
  283.  
  284. PROCEDURE ReadByte () : BOOLEAN;
  285. VAR t, dat : CARDINAL;
  286. BEGIN
  287.   IF Aborting THEN
  288.     t := 10
  289.   ELSE
  290.     t := 30
  291.   END;
  292.   dat := CommRdDataTest ( t );
  293.   Ch := VAL(SHORTCARD, dat );
  294.   CASE dat OF
  295.       ComTimedOut : RETURN FALSE;
  296. |     ComAbort    :  AbortRequest := TRUE;
  297.                       INC (AbortCount);
  298.                       IF AbortCount >= AbortMax THEN
  299.                         FatalAbort := TRUE;
  300.                       END;
  301.                       RETURN FALSE;
  302.   END;  (* CASE *)
  303.   RETURN TRUE;
  304. END ReadByte;
  305.  
  306. PROCEDURE ReadQuotedByte () : BOOLEAN;
  307. VAR t, dat : CARDINAL;
  308. BEGIN
  309.   Quoted := FALSE;
  310.   IF Aborting THEN
  311.     t := 10
  312.   ELSE
  313.     t := 30
  314.   END;
  315.   dat := CommRdData ( t );
  316.   Ch := VAL(SHORTCARD, dat );
  317.   CASE dat OF
  318.        ComTimedOut : RETURN FALSE;
  319.          |ComAbort : AbortRequest := TRUE;
  320.                      INC (AbortCount);
  321.                      IF AbortCount >= AbortMax THEN
  322.                         FatalAbort := TRUE;
  323.                      END;
  324.                      RETURN FALSE;
  325.   END;  (* CASE *)
  326.   IF Ch = dle THEN
  327.       IF NOT ReadByte() THEN
  328.          RETURN FALSE;
  329.       END;
  330.       IF Ch < 60H THEN
  331.          Ch := Ch MOD 20H;
  332.       ELSE
  333.          Ch := Ch MOD 20H + 80H
  334.       END;
  335.       Quoted := TRUE;
  336.   END;
  337.   RETURN TRUE;
  338. END ReadQuotedByte;
  339.  
  340. PROCEDURE ShowFailure;
  341. BEGIN
  342.     SendACK;
  343.     CASE CHR( RBuf^[1] ) OF
  344.          'A': MsgStr := 'Host aborting transfer.';
  345.         |'C': MsgStr := 'Host out of memory; aborting transfer.';
  346. |'E','N','S': MsgStr := 'Processing failure; host aborting transfer.';
  347.         |'I': MsgStr := 'Input-output error; host aborting transfer.';
  348.         |'M': MsgStr := 'File requested is missing; host aborting transfer.';
  349.         |'r': MsgStr := 'Transfer resume failure; aborting.';
  350.     END;
  351.     StatusMessage ( MsgStr, FALSE );
  352. END ShowFailure;
  353.  
  354. PROCEDURE SendFailure (Reason : ARRAY OF CHAR ); FORWARD;
  355.  
  356. PROCEDURE ReadPacket (LeadInSeen, FromSendPacket : BOOLEAN) : BOOLEAN;
  357. (* LeadInSeen is TRUE if the <DLE><B> has been seen already.
  358.    FromSendPacket is TRUE if called from SendPacket; if it is true,
  359.    ReadPacket returns on first error detected.
  360.    ReadPacket returns TRUE if packet is available from host. *)
  361.  
  362. TYPE
  363.     ReceiveStateType = (
  364.           RGetDle,
  365.           RGetB,
  366.           RGetSeq,
  367.           RGetData,
  368.           RGetCheck,
  369.           RSendAck,
  370.           RTimedOut,
  371.           RError,
  372.           RSuccess );
  373.  
  374. VAR
  375.   State   : ReceiveStateType;
  376.   PacketNum,
  377.   errors,
  378.   newCks,
  379.   i       : CARDINAL;
  380.   NAKSent : BOOLEAN;    (* TRUE IF <NAK> was sent *)
  381.  
  382. BEGIN
  383.   IF PacketReceived THEN  (* See if Packet was picked up on a call to *)
  384.       PacketReceived := FALSE;  (* GetACK *)
  385.       RETURN TRUE;
  386.   END;
  387.   NAKSent := FALSE;
  388.   errors := 0;
  389.   IF LeadInSeen THEN
  390.     State := RGetSeq (* Start off on the correct foot *)
  391.   ELSE
  392.     State := RGetDle
  393.   END;
  394.   LOOP
  395.       CASE  (State) OF
  396.   RGetDle : IF AbortRequest AND NOT Aborting THEN
  397.                 StatusMessage (AbortMsg, FALSE);
  398.                 SendFailure (AFailureMsg);
  399.                 RETURN FALSE;
  400.             END;
  401.             IF NOT ReadByte() THEN
  402.                 State := RTimedOut
  403.             ELSE
  404.               CASE Ch OF
  405.                    dle: State := RGetB;
  406.                   |enq: State := RSendAck;
  407.               END
  408.             END;
  409.    |RGetB : Fill ( RBuf, BufferSize, 0);
  410.             IF NOT ReadByte() THEN
  411.               State := RTimedOut
  412.             ELSE CASE Ch OF
  413.   SHORTCARD ('B'): State := RGetSeq;
  414.              |enq: State := RSendAck;
  415. (*  |SHORTCARD(';'): State := RGetDle; *)
  416.               ELSE State := RGetDle
  417.             END END;
  418.  |RGetSeq : IF NOT ReadByte() THEN
  419.               State := RTimedOut
  420.             ELSIF Ch = enq THEN
  421.               State := RSendAck;
  422.             ELSE
  423.                 PacketNum := ORD(Ch - SHORTCARD ('0'));
  424.                 checksum := UpdChk ( ADR(Ch), 1, chkInit );
  425.                 i := 0;
  426.                 State := RGetData;
  427.             END;
  428. |RGetData : IF NOT ReadQuotedByte() THEN
  429.                    State := RTimedOut
  430.             ELSIF (Ch = etx) AND NOT Quoted THEN
  431.                 checksum := UpdChk ( ADR(Ch), 1, UpdChk (RBuf, i, checksum) );
  432.                 State := RGetCheck;
  433.             ELSIF i <= MaxBufSize THEN
  434.                 RBuf^[i] := Ch;
  435.                 INC(i);
  436.             ELSE
  437.                 StatusMessage ('Buffer overrun.', FALSE);
  438.                 State := RGetDle;
  439.             END;
  440.        |RGetCheck :
  441.             IF ReadQuotedByte() THEN
  442.                 IF BPlusOn AND UseCRC THEN (* ??? *)
  443.                     checksum := UpdChk (ADR(Ch), 1, checksum );
  444.                     IF ReadQuotedByte() THEN
  445.                         checksum := UpdChk (ADR(Ch), 1, checksum );
  446.                         newCks := 0;
  447.                     ELSE
  448.                         newCks := CARDINAL(BITSET(checksum) / BITSET(0FFH))
  449.                     END;
  450.                 ELSE
  451.                    newCks := ORD( Ch )
  452.                 END;
  453.                 IF RBuf^[0] = SHORTCARD('F') THEN (* Failure Packet *)
  454.                    ShowFailure;
  455.                    State := RSuccess            (* is accepted regardless *)
  456.                 ELSIF (PacketNum = seqNum) THEN (* Watch for duplicate *)
  457.                    IF (CHR (RBuf^[0])  = 'T') AND (CHR (RBuf^[1])  = 'C') THEN
  458.                         RETURN TRUE   (* Duplicate TC; D-d-d-dat's all folks *)
  459.                    ELSE
  460.                         State := RSendAck         (* Simply ACK it *)
  461.                    END
  462.                 ELSIF PacketNum = (seqNum + 1) MOD 10 THEN
  463.                    IF newCks = checksum THEN
  464.                         State := RSuccess
  465.                    ELSE
  466.                         StatusMessage('Bad checksum.', FALSE );
  467.                         State := RError
  468.                    END
  469.                 ELSE
  470.                    State := RGetDle;      (* Bad sequence number *)
  471.                 END;
  472.             ELSE
  473.               State := RTimedOut
  474.             END;
  475.        |RTimedOut :
  476.             IF AbortRequest THEN
  477.                 State := RGetDle;
  478.             ELSE
  479.                 StatusMessage (TimeoutMsg, FALSE);
  480.                 State := RError;
  481.            END;
  482.        |RError :
  483.             INC (errors);
  484.             IF (errors > MaxErrors) OR FromSendPacket OR FatalAbort THEN
  485.                 RETURN FALSE;
  486.             END;
  487.             IF NOT NAKSent OR NOT BPlusOn THEN
  488.                 NAKSent := TRUE;
  489.                 SendNAK;
  490.             END;
  491.             State := RGetDle;
  492.        |RSendAck :
  493.             IF NOT Aborting THEN
  494.               SendACK;
  495.             END;
  496.             State := RGetDle;  (* wait for the next packet *)
  497.        |RSuccess :
  498.             DisplayData ( TotalBytes, TRUE);
  499.             DisplayData ( TotalBytes, FALSE );
  500.             IF NOT Aborting THEN
  501.               seqNum := PacketNum
  502.             END;
  503.             RSize := i;
  504.             INC (DataRegisters[ TRUE, Packets ]);
  505.             DisplayData ( Packets, TRUE );
  506.             RETURN TRUE;
  507.       END; (* CASE *)
  508.     END; (* LOOP *)
  509. END ReadPacket;
  510.  
  511. PROCEDURE SendData (BufferNumber : CARDINAL);
  512. VAR i : CARDINAL; ch: SHORTCARD;
  513. BEGIN
  514.     WITH SABuf[BufferNumber] DO
  515.         checksum := chkInit;
  516.         CommWrData (dle);
  517.         CommWrData ('B');
  518.         ch := SHORTCARD(seq) + SHORTCARD('0');
  519.         CommWrData ( ch );
  520.         checksum := UpdChk ( ADR(ch), 1, checksum  );
  521.         FOR i := 0 TO num DO
  522.           SendQuotedByte (buf^[i]);
  523.         END;
  524.         checksum := UpdChk (buf, num+1, checksum  );
  525.         CommWrData (etx);
  526.         ch := etx;
  527.         checksum := UpdChk ( ADR(ch), 1, checksum  );
  528.         IF UseCRC THEN
  529.             SendQuotedByte (VAL(SHORTCARD,HI(checksum)) );
  530.         END;
  531.         SendQuotedByte (VAL(SHORTCARD,checksum));
  532.       END;
  533. END SendData;
  534.  
  535. PROCEDURE ReSync () : SHORTCARD;
  536. (* called to restablish syncronism with the remote by Sending <ENQ><ENQ> and
  537.   waiting for <DLE><d><DLE><d>, ignoring everything else.  Return is ORD('T')
  538.   on time out, `B` IF <DLE><B>, 'E' if <ENQ>, the digit <d> if successful. *)
  539.  
  540. TYPE
  541.   ReSyncStateType = (
  542.     GetFirstDle,
  543.     GetFirstDigit,
  544.     GetSecondDle,
  545.     GetSecondDigit);
  546.  
  547. VAR
  548.   State  : ReSyncStateType;
  549.   Digit1 : SHORTCARD;
  550.  
  551. BEGIN
  552.   SendENQ;    (* Send <ENQ><ENQ> *)
  553.   State := GetFirstDle;
  554.  
  555.   LOOP
  556.       CASE (State) OF
  557.       GetFirstDle : IF NOT ReadByte() THEN
  558.                         RETURN SHORTCARD('T')
  559.                     END;
  560.                     CASE Ch OF
  561.                         dle: State := GetFirstDigit;
  562.                        |enq: RETURN SHORTCARD('E'); (* totally out of synch *)
  563.                     END;
  564.      |GetFirstDigit : IF NOT ReadByte() THEN
  565.                         RETURN SHORTCARD('T')
  566.                     END;
  567.                     CASE CHR(Ch) OF
  568.               '0'..'9': Digit1 := Ch;
  569.                         State := GetSecondDle;
  570.                   |'B': RETURN Ch;
  571.                     END;
  572.     |GetSecondDle : IF NOT ReadByte() THEN
  573.                         RETURN SHORTCARD('T')
  574.                     END;
  575.                     IF Ch = dle THEN
  576.                         State := GetSecondDigit;
  577.                     END;
  578.   |GetSecondDigit : IF NOT ReadByte() THEN
  579.                         RETURN SHORTCARD('T')
  580.                     END;
  581.                     CASE CHR(Ch) OF
  582.               '0'..'9': IF Digit1 = Ch THEN
  583.                            RETURN Ch;
  584.                         END;
  585.                         Digit1 := Ch;
  586.                         State := GetSecondDle;
  587.                   |'B': RETURN Ch;
  588.                    ELSE State := GetSecondDle
  589.                     END;
  590.       END; (* CASE *)
  591.     END;  (* LOOP *)
  592. END ReSync;
  593.  
  594. PROCEDURE GetACK (): BOOLEAN;
  595. (* called to wait until the host ACKs SABuf indicated by SANextToACK *)
  596.  
  597. TYPE
  598.     SendStateType = (
  599.           SGetDle,
  600.           SGetNum,
  601.           SHaveACK,
  602.           SGetPacket,
  603.           SSkipPacket,
  604.           STimedOut,
  605.           SError,
  606.           SSendNak,
  607.           SSendEnq,
  608.           SSendData );
  609.  
  610. VAR
  611.   State    : SendStateType;
  612.   PacketNum,
  613.   errors,
  614.   i,
  615.   SAIndex : CARDINAL;
  616.   SentEnq : BOOLEAN;
  617.  
  618. PROCEDURE GotNak;
  619. BEGIN
  620.     INC(DataRegisters[FALSE, Errs]);
  621.     DisplayData( Errs, FALSE );
  622.     State := SSendEnq
  623. END GotNak;
  624.  
  625. BEGIN
  626.   PacketReceived := FALSE;
  627.   errors := 0;
  628.   SentEnq := FALSE;
  629.   State := SGetDle;
  630.  
  631.   LOOP
  632.     CASE (State) OF
  633.       SGetDle :
  634.               IF AbortRequest AND NOT Aborting THEN
  635.               StatusMessage (AbortMsg,  FALSE);
  636.               SendFailure (AFailureMsg);
  637.               RETURN FALSE;
  638.           END;
  639.           IF NOT ReadByte() THEN
  640.               State := STimedOut
  641.           ELSE
  642.               CASE Ch OF
  643.                    dle: State := SGetNum;
  644.                   |nak: GotNak;
  645.                   |enq: SendACK; (* DIAG *)
  646.                         StatusMessage('RESYNC ERROR 1', FALSE ); (* DIAG *)
  647.                         SendFailure ('SProtocol sequence failure');
  648.                         RETURN FALSE; (* totally out of synch *)
  649.                   |etx: State := SSendNak;
  650.               END;
  651.           END;
  652.      |SGetNum :
  653.           IF NOT ReadByte() THEN
  654.               State := STimedOut
  655.           ELSE CASE Ch OF
  656.    SHORTCARD('0')..
  657.    SHORTCARD('9'): State := SHaveACK
  658.   |SHORTCARD('B'): IF Aborting THEN
  659.                      State := SSkipPacket;
  660.                    ELSE
  661.                      State := SGetPacket
  662.                    END;
  663.              |nak: GotNak;
  664.   |SHORTCARD(';'):
  665. State := SGetDle; (* WACK (Wait Acknowledge) *)
  666.              ELSE State := SGetDle;
  667.          END END;
  668.      |SGetPacket :
  669.           IF ReadPacket (TRUE, TRUE) THEN
  670.               PacketReceived := TRUE;
  671.               IF RBuf^[0] = SHORTCARD('F') THEN (* Failure Packet *)
  672.                   ShowFailure;
  673.                   RETURN FALSE;
  674.               END;
  675. (*            State := SGetDle;       Stay here to find the ACK *)
  676.               SANextToACK := (SANextToACK + 1) MOD (MaxSA + 1);
  677.               DEC( SAWaiting );
  678.               RETURN TRUE
  679.           ELSIF (AbortRequest AND NOT Aborting) OR FatalAbort THEN
  680.               RETURN FALSE
  681.           ELSE
  682.               State := SGetDle;   (* Receive failed; keep watching FOR ACK *)
  683.           END;
  684.      |SSkipPacket :                (* Skip an incoming Packet *)
  685.           IF NOT ReadByte() THEN
  686.               State := STimedOut
  687.           ELSIF Ch = etx THEN
  688.               IF NOT ReadQuotedByte() THEN (* Get Checksum or CRC *)
  689.                  State := STimedOut
  690.               ELSIF NOT UseCRC THEN
  691.                  State := SGetDle
  692.               ELSIF NOT ReadQuotedByte() THEN
  693.                  State := STimedOut
  694.               ELSE
  695.                  State := SGetDle
  696.               END;
  697.           END;
  698.      |SHaveACK :
  699.           PacketNum := ORD(Ch - SHORTCARD('0'));
  700.           IF SABuf[SANextToACK].seq = PacketNum THEN
  701.               (* This is the one we're waiting for *)
  702.               SANextToACK := (SANextToACK + 1) MOD (MaxSA + 1);
  703.               DEC( SAWaiting );
  704.               IF SAErrors > 0      (* Apply heuristic to control *)
  705.                THEN DEC (SAErrors); (* Upload Performance degradation *)
  706.               END;
  707.               RETURN TRUE;
  708.           END;
  709.           IF (SABuf [ (SANextToACK + 1) MOD (MaxSA + 1) ].seq = PacketNum)
  710.              AND (SAWaiting = 2) THEN         (* Must have missed an ACK *)
  711.               SANextToACK := (SANextToACK + 2) MOD (MaxSA + 1);
  712.               DEC ( SAWaiting, 2 );
  713.               IF SAErrors > 0 THEN
  714.                 DEC (SAErrors)
  715.               END;
  716.               RETURN TRUE;
  717.           END;
  718.           IF SABuf [SANextToACK].seq = (PacketNum + 1) MOD 10 THEN
  719.             IF SentEnq THEN
  720.               State := SSendData (* Remote missed first packet*)
  721.             ELSE
  722.               State := SGetDle   (* Duplicate ACK *)
  723.             END;
  724.           ELSE                   (* WHILE aborting, *)
  725.             IF NOT Aborting THEN
  726.               State := STimedOut (* ignore ACKs *)
  727.             ELSE
  728.               State := SGetDle   (* which are NOT for failure Packet.*)
  729.             END;
  730.           END;
  731.           SentEnq := FALSE;
  732.      |STimedOut :
  733.           State := SSendEnq;
  734.      |SSendNak :
  735.           INC (errors);
  736.           IF (errors > MaxErrors) THEN
  737.               StatusMessage('Too many errors; Aborting.', FALSE);
  738.           END;
  739.           IF (errors > MaxErrors) OR FatalAbort THEN
  740.               RETURN FALSE;
  741.           END;
  742.           SendNAK;
  743.           State := SGetDle;
  744.      |SSendEnq :
  745.            INC (errors);
  746.            IF (errors > MaxErrors) OR (Aborting AND (errors > 3)) THEN
  747.               StatusMessage('Too many errors; Aborting.', FALSE);
  748.               RETURN FALSE;
  749.            END;
  750.            Ch := ReSync();
  751.            CASE CHR(Ch) OF
  752.               'T': State := SGetDle;
  753.              |'B': IF Aborting THEN
  754.                         State := SSkipPacket
  755.                    ELSE
  756.                         State := SGetPacket
  757.                    END;
  758.              |'E': StatusMessage('RESYNC ERROR 2', FALSE ); (* DIAG *)
  759.                    RETURN FALSE;
  760.               ELSE State := SHaveACK;
  761.            END;
  762.            SentEnq   := TRUE;
  763.      |SSendData :
  764.            INC (SAErrors, 3);
  765.            IF SAErrors >= 12 THEN
  766.               SAMax := 1
  767.            END;
  768.            SAIndex := SANextToACK;
  769.            FOR i := 1 TO SAWaiting DO
  770.                SendData (SAIndex);
  771.                SAIndex := (SAIndex + 1) MOD (MaxSA + 1);
  772.            END;
  773.            State := SGetDle;
  774.            SentEnq := FALSE;
  775.     END; (* CASE *)
  776.   END; (* LOOP *)
  777. END GetACK;
  778.  
  779. PROCEDURE SendPacket (size : CARDINAL) : BOOLEAN;
  780. BEGIN
  781.   WHILE (SAWaiting >= SAMax) DO
  782.     IF NOT GetACK() THEN
  783.       RETURN FALSE;   (* Allow for possible drop out of Send Ahead *)
  784.     END
  785.   END;
  786.   seqNum := (seqNum + 1) MOD 10;
  787.   SABuf [SANextToFill].seq := seqNum;
  788.   SABuf [SANextToFill].num := size;
  789.   SendData (SANextToFill);
  790.   SANextToFill := (SANextToFill + 1) MOD (MaxSA + 1);
  791.   INC( SAWaiting );
  792.   INC (DataRegisters[ FALSE, Packets ]);
  793.   DisplayData ( Packets, FALSE );
  794.   RETURN TRUE
  795. END SendPacket;
  796.  
  797. PROCEDURE SAFlush () : BOOLEAN;
  798. (*called after sending last packet to get host's ACKs on outstanding packets.*)
  799. BEGIN
  800.   WHILE SAWaiting > 0 DO
  801.     IF NOT GetACK() THEN
  802.         RETURN FALSE;
  803.     END;
  804.     RETURN TRUE;
  805.   END;
  806. END SAFlush;
  807.  
  808. PROCEDURE SendFailure (Reason : ARRAY OF CHAR );
  809. BEGIN
  810.   SANextToACK := 0;
  811.   SANextToFill := 0;
  812.   SAWaiting := 0;
  813.   Aborting   := TRUE; (* Required by GetACK *)
  814.   WITH SABuf [0] DO
  815.       buf^[0] := SHORTCARD ('F');
  816.       Move( ADR(Reason), ADR(buf^[1]), Length(Reason) )
  817.   END;
  818.   IF  SendPacket (Length (Reason)) AND
  819.       SAFlush() THEN (* wait for ACK *)
  820.   END
  821. END SendFailure;
  822.  
  823. PROCEDURE SendFile (name : PathStr );
  824. (* called to Send a file to the host *)
  825. VAR n : CARDINAL;
  826. BEGIN
  827.   DataFile := Open(name);
  828.   IF DataFile = MAX( CARDINAL ) THEN
  829.       StatusMessage (OpenError, TRUE);
  830.       SendFailure ('MFile not found');
  831.       RETURN
  832.   END;
  833.   DataRegisters[ FALSE, DataLeft ] := Size (DataFile);
  834.   StartTimer(ForTransfer);
  835.   StartTimer(ForPacket);
  836.   ShowTimeLeft( FALSE );
  837.   WHILE NOT EOF(DataFile) DO
  838.     SABuf[SANextToFill].buf^[0] := SHORTCARD('N');
  839.     n := RdBin (DataFile, SABuf[SANextToFill].buf^[1], BufferSize);
  840.     IF NOT OK THEN
  841.          SendFailure ('EFile read failure');
  842.          StatusMessage ('Read error. Aborting', TRUE);
  843.          RETURN
  844.     END;
  845.     IF NOT SendPacket (n) THEN
  846.          RETURN
  847.     END;
  848.     IncrDataBytes( n, FALSE );
  849.   END;
  850.   Close (DataFile);
  851.   SABuf [SANextToFill].buf^[0] := SHORTCARD ('T');
  852.   SABuf [SANextToFill].buf^[1] := SHORTCARD ('C');
  853.   IF SendPacket (2) AND SAFlush() THEN END;
  854. END SendFile;
  855.  
  856. PROCEDURE DoTransportParameters;
  857. (*  Called when a '+' packet is received. Sends our default B Plus parameters,
  858.     sets Our.xx parameters to minimum of host's and default parameters. *)
  859.  
  860. VAR
  861.   QuoteSetPresent : BOOLEAN;
  862.  
  863.   PROCEDURE PickMin( A, B: BYTE): BYTE;
  864.   BEGIN
  865.       IF A < B THEN RETURN A END;
  866.       RETURN B
  867.   END PickMin;
  868.  
  869. BEGIN
  870.   IF SpecialQuoting THEN
  871.     Our.QS := SpecialQuoteSet
  872.   ELSE
  873.     Our.QS := DQextended;
  874.   END;
  875.   IF AutoResume THEN
  876.      DefPtr^.DR := 2 (* Set Download Resume according to *)
  877.   ELSE          (* user's preference *)
  878.      DefPtr^.DR := 1
  879.   END;
  880.   Move ( ADR( RBuf^[1] ), ADR(His), 17 ); (* Initiator's parameters *)
  881.   QuoteSetPresent := RSize >= 14;
  882.   WITH SABuf [SANextToFill] DO
  883.       buf^[0] := SHORTCARD('+');  (* Prepare to return Our own parameters *)
  884.       Move ( ADR(Def), ADR( buf^[1] ), 17 );
  885.   END;
  886.   UpdateQuoteTable (DQfull);   (* Send the + Packet under full quoting *)
  887.   IF NOT SendPacket (17) THEN
  888.     RETURN
  889.   END;
  890.   IF SAFlush() THEN      (* Wait for host's ACK on Our Packet *)
  891.       Our.WR := PickMin( His.WS, DefPtr^.WR );
  892.       Our.WS := PickMin( His.WR, DefPtr^.WS );
  893.       Our.BS := PickMin( His.BS, DefPtr^.BS );
  894.       Our.CM := His.CM AND DefPtr^.CM;
  895.       Our.DR := PickMin( His.DR, DefPtr^.DR );
  896.       Our.UR := PickMin( His.UR, DefPtr^.UR );
  897.       Our.FI := PickMin( His.FI, DefPtr^.FI );
  898.       IF Our.BS = 0 THEN
  899.          Our.BS := 4     (* Default *)
  900.       END;
  901.       BufferSize := ORD(Our.BS) * 128;
  902.       BPlusOn := TRUE;
  903.       UseCRC := Our.CM;
  904.       IF UseCRC THEN
  905.          UpdChk := DoCRC;
  906.          chkInit := 0FFFFH
  907.       END;
  908.       IF Our.WS <> 0 THEN
  909.          SAMax := MaxSA
  910.       END;
  911.   END;
  912.   Fill( ADR(QuoteTable), SIZE(QuoteTable), 0);
  913.  
  914.   UpdateQuoteTable (Our.QS);   (* Restore Our Quoting Set *)
  915.   IF QuoteSetPresent THEN
  916.     UpdateQuoteTable (His.QS); (* Insert Initiator's Quote Set *)
  917.   END;
  918. END DoTransportParameters;
  919.  
  920. PROCEDURE CheckKeep ( Name : ARRAY OF CHAR );
  921. (* Called from ReceiveFile when a fatal error occurs to ask if file
  922.    should be retained *)
  923. VAR
  924.   Retain : BOOLEAN;
  925. BEGIN
  926.   Close (DataFile);
  927.   IF (NOT AutoResume) OR (NOT BPlusOn) OR (Our.DR = 0) THEN
  928.       Concat( MsgStr, 'Do you wish to retain the partial ', Name );
  929.       Append( MsgStr, '? ');
  930.       Retain := Yes (MsgStr)
  931.   ELSE
  932.       Retain := TRUE
  933.   END;
  934.   IF Retain THEN
  935.       StatusMessage ('File retained.', TRUE);
  936.   ELSE
  937.       Erase (Name);
  938.       StatusMessage ('File erased.', TRUE);
  939.   END;
  940. END CheckKeep;
  941.  
  942. PROCEDURE FileCreated( Name : ARRAY OF CHAR ): BOOLEAN;
  943. BEGIN
  944.     DataFile := Create( Name );
  945.     IF DataFile = MAX ( CARDINAL ) THEN
  946.          StatusMessage(CreateError, FALSE);
  947.          SendFailure ('CCannot create file');
  948.          RETURN FALSE;
  949.     END;
  950.     SendACK;
  951.     RETURN TRUE
  952. END FileCreated;
  953.  
  954. PROCEDURE ReceiveData (Name : ARRAY OF CHAR): BOOLEAN;
  955. (* called by ReceiveFile or ReceiveGIF *)
  956.  
  957. VAR Drive       : SHORTCARD;
  958.     ClusterSize : CARDINAL;
  959.  
  960. PROCEDURE ReceiveFileSize;
  961. (* called from ReceiveFile when TI Packet is received to process information *)
  962. VAR
  963.   i : CARDINAL;
  964. BEGIN
  965.   i := 4;       (* Skip data type and compression flag *)
  966.   WHILE ( i < RSize ) AND NOT( CHR(RBuf^[i]) IN CHARSET{'0'..'9'} ) DO
  967.     INC(i)
  968.   END;
  969.   RFileSize := 0;
  970.   WHILE ( i < RSize ) AND ( CHR(RBuf^[i]) IN CHARSET{'0'..'9'} ) DO
  971.     RFileSize := RFileSize*10 +
  972.          VAL(LONGCARD, SHORTCARD(RBuf^[i])-SHORTCARD('0') );
  973.     INC(i)
  974.   END;
  975. END ReceiveFileSize;
  976.  
  977. BEGIN
  978.   StartTimer(ForPacket);
  979.   StartTimer(ForTransfer);
  980.   LOOP
  981.       IF ReadPacket (FALSE, FALSE) THEN
  982.             CASE CHR (RBuf^[0]) OF
  983.             'N' : IF ResumeFlag THEN
  984.                       StatusMessage ('Resuming Download', FALSE);
  985.                       ResumeFlag := FALSE;
  986.                   END;
  987.                   WrBin (DataFile, RBuf^[1], RSize - 1 );
  988.                   IF NOT OK THEN
  989.                       StatusMessage (WriteErrorMsg, FALSE);
  990.                       SendFailure ('EWrite failure');
  991.                       CheckKeep (Name);
  992.                       RETURN FALSE;
  993.                   END;
  994.                   IncrDataBytes( RSize - 1, TRUE );
  995.                   SendACK;
  996.            |'T' : CASE CHR(RBuf^[1]) OF
  997.                  'C': Close (DataFile);
  998.                       UpdateData;
  999.                       IF NOT OK THEN
  1000.                           StatusMessage (CloseError, FALSE);
  1001.                           SendFailure ('EError during close');
  1002.                           CheckKeep (Name);
  1003.                           RETURN FALSE;
  1004.                       END;
  1005.                       SendACK;
  1006.                       RETURN TRUE;
  1007.                 |'I': SendACK;
  1008.                       ReceiveFileSize;
  1009.                       IF RFileSize > FileLength THEN
  1010.                         DataRegisters[TRUE,DataLeft] := RFileSize - FileLength;
  1011.                         ShowTimeLeft( TRUE );
  1012.                       END;
  1013.                       IF RFileSize > 0 THEN
  1014.                          IF Name[1] = ':' THEN
  1015.                              Drive := SHORTCARD(CAP(Name[0]))
  1016.                                   - SHORTCARD('@');
  1017.                          ELSE
  1018.                              Drive := GetDrive()
  1019.                          END;
  1020.                          IF DiskFree(Drive, ClusterSize) < RFileSize THEN
  1021.                       StatusMessage('Insufficient disk space. Aborting', TRUE);
  1022.                              SendFailure ('CInsufficient disk space.');
  1023.                              Close (DataFile);
  1024.                              RETURN FALSE;
  1025.                          END;
  1026.                          StartTimer(ForPacket);
  1027.                          StartTimer(ForTransfer);
  1028.                              (* restart for more accurate estimate *)
  1029.                          DisplayData ( DataLeft, TRUE )
  1030.                      END;
  1031.                 |'f': IF AutoResume THEN (* host failed CRC check *)
  1032.                         Close (DataFile);
  1033.                         IF NOT FileCreated(Name) THEN
  1034.                              RETURN FALSE;
  1035.                         END;
  1036.                         IF Our.FI <> 0 THEN
  1037.                              DataRegisters[ TRUE, DataLeft ] := RFileSize;
  1038.                         END;
  1039.                         RFileSize := 0;
  1040.                   StatusMessage ('CRC check failed; overwriting file', FALSE);
  1041.                         ResumeFlag := FALSE;
  1042.                         DataRegisters[ FALSE, TotalBytes ] := 0; (* ??? *)
  1043.                         DataRegisters[ TRUE, TotalBytes ] := 0; (* ??? *)
  1044.                       END;
  1045.                  ELSE
  1046.          StatusMessage ('Invalid termination packet. Aborting', FALSE);
  1047.                       SendFailure ('NInvalid T Packet');
  1048.                       CheckKeep (Name);
  1049.                       RETURN FALSE;
  1050.               END;
  1051.              |'F' : ShowFailure;
  1052.                     CheckKeep (Name);
  1053.                     RETURN FALSE;
  1054.               END; (* CASE *)
  1055.         ELSE  (* ReadPacket *)
  1056.             IF NOT Aborting THEN
  1057.                 StatusMessage('Download failed', FALSE)
  1058.             END;
  1059.             CheckKeep (Name);
  1060.             RETURN FALSE;
  1061.        END;
  1062.     END; (* LOOP *)
  1063. END ReceiveData;
  1064.  
  1065. PROCEDURE ReceiveFile (Name : ARRAY OF CHAR);
  1066. (* called to receive a file from the host *)
  1067.  
  1068. VAR
  1069.   PacketLen,
  1070.   i, n       : CARDINAL;
  1071.   DowType    : CHAR;
  1072.   dummy      : BOOLEAN;
  1073.  
  1074. BEGIN
  1075.   DowType := 'D';         (* Assume normal downloading *)
  1076.   RFileSize := 0;
  1077.   FileLength := 0;
  1078.   IF Exists(Name)  THEN  (* See if we can try automatic resume *)
  1079.       IF (Our.DR > 1) AND AutoResume THEN
  1080.          DowType := 'R' (* Remote supports `Tf', let's try it *)
  1081.       ELSIF (Our.DR > 0) THEN
  1082.           IF Yes('File exists. Do you wish to resume downloading?') THEN
  1083.               DowType := 'R';
  1084.           ELSE
  1085.               StatusMessage ('File being overwritten.', FALSE)
  1086.           END;
  1087.       END;
  1088.   END;
  1089.   CASE DowType OF
  1090.    'D': IF NOT FileCreated( Name ) THEN
  1091.             RETURN;
  1092.         END;
  1093.  |'R' : DataFile := Open ( Name ); (* Resume download *)
  1094.         IF DataFile = MAX ( CARDINAL ) THEN
  1095.             StatusMessage(OpenError, FALSE);
  1096.             SendFailure ('MFile not found');
  1097.             RETURN;
  1098.         END;
  1099.         StatusMessage ('Calculating CRC', FALSE);
  1100.         WITH SABuf [SANextToFill] DO  (* ASSUMES CRC *)
  1101.             checksum := 0FFFFH;
  1102.             LOOP
  1103.                n := RdBin (DataFile, buf^, BufferSize );
  1104.                IF (n = 0) OR (NOT OK) THEN
  1105.                    EXIT
  1106.                END;
  1107.                checksum := UpdChk (buf, n, checksum )
  1108.             END;
  1109.             buf^[0] := SHORTCARD ('T');
  1110.             buf^[1] := SHORTCARD ('r');
  1111.             PacketLen := 2;
  1112.             FileLength := Size (DataFile);
  1113.             CardToString( FileLength, MsgStr, 0, 0C );
  1114.             Append (MsgStr, ' ');
  1115.             i := Length(MsgStr);
  1116.             Move ( ADR(MsgStr), ADR(buf^[PacketLen]), i );
  1117.             INC( PacketLen, i );
  1118.             CardToString( VAL(LONGCARD, checksum), MsgStr, 0, 0C );
  1119.             Append (MsgStr, ' ');
  1120.             i := Length(MsgStr);
  1121.             Move ( ADR(MsgStr), ADR(buf^[PacketLen]), i );
  1122.             INC( PacketLen, i );
  1123.         END; (* WITH *)
  1124.         IF NOT SendPacket(PacketLen-1) OR NOT SAFlush() THEN
  1125.             Close (DataFile); (* SendData Sends 0..size *)
  1126.             RETURN;
  1127.         END;
  1128.         SeekEOF(DataFile);   (* Ready to append *)
  1129.         StatusMessage ('Host calculating CRC...', FALSE);
  1130.         ResumeFlag := TRUE;
  1131.     END; (* CASE *)
  1132.     dummy := ReceiveData( Name );
  1133. END ReceiveFile;
  1134.  
  1135. PROCEDURE CreateBufs;
  1136. (* Must call at start of DleBSeen *)
  1137. VAR n : CARDINAL;
  1138. BEGIN
  1139.   FOR n := 0 TO MaxSA DO
  1140.     NEW( SABuf[n].buf )
  1141.   END;
  1142.   NEW ( RBuf );
  1143. END CreateBufs;
  1144.  
  1145. PROCEDURE ReleaseBufs;
  1146. (* Must call before returning from DleBSeen *)
  1147. VAR n : CARDINAL;
  1148. BEGIN
  1149.   FOR n := 0 TO MaxSA DO
  1150.     DISPOSE( SABuf[n].buf )
  1151.   END;
  1152.   DISPOSE( RBuf );
  1153. END ReleaseBufs;
  1154.  
  1155. PROCEDURE ReceiveGIF;
  1156. VAR GotIt : BOOLEAN;
  1157. BEGIN
  1158.     PacketReceived := TRUE;
  1159.     ResumeFlag := FALSE;
  1160.     IF NOT FileCreated( GifTempName  ) THEN
  1161.          RETURN;
  1162.     END;
  1163.     GotIt := ReceiveData( GifTempName );
  1164.     ShowTransferTime;
  1165.     ReleaseBufs;
  1166.     IF GotIt THEN
  1167.          ShowSaveGif;
  1168.     END;
  1169. END ReceiveGIF;
  1170.  
  1171. PROCEDURE TurnDisplayOn( FileName: ARRAY OF CHAR; Receiving: BOOLEAN );
  1172. BEGIN
  1173.     FlushLog;
  1174. (*  TempBytes := DataRegisters[ TRUE, TotalBytes ]; *)
  1175.     StartDisplay( TRUE, BPlus, Receiving );
  1176.     ShowFileName( FileName, Receiving );
  1177.     ShowTransferType ( FileType );
  1178. (*  DataRegisters[ TRUE, TotalBytes ] := TempBytes; *)
  1179.     ShowErrorType(UseCRC);
  1180.     IF BPlusOn THEN
  1181.          ShowPacketSize( BufferSize );
  1182.          IF Our.WS > 0 THEN
  1183.               StatusMessage( 'Send-Ahead enabled', FALSE )
  1184.          END
  1185.     END;
  1186. END TurnDisplayOn;
  1187.  
  1188. BEGIN   (* DleBSeen *)
  1189.   SANextToACK    := 0;    (* Initialize variables *)
  1190.   SANextToFill   := 0;
  1191.   SAWaiting      := 0;
  1192.   Aborting       := FALSE;
  1193.   AbortRequest   := FALSE;
  1194.   FatalAbort     := FALSE;
  1195.   AbortCount     := 0;
  1196.   PacketReceived := FALSE;
  1197.   ResumeFlag := FALSE;
  1198.  
  1199.   (* Establish data block size to keep time per packet at 4-5 seconds *)
  1200.   CASE QCDefPtr^.baud OF
  1201.        0 : DefPtr^.BS := 1; (* 300 *)
  1202.     |1,2 : DefPtr^.BS := 4; (* 600, 1200 *)
  1203.      |ELSE DefPtr^.BS := 8;
  1204.   END; (* CASE *)
  1205.  
  1206.   CreateBufs;
  1207.  
  1208.   DataRegisters[ TRUE, TotalBytes ] := 2; (* DLE B *)
  1209.  
  1210.   IF ReadPacket (TRUE, FALSE) THEN
  1211.      CASE CHR (RBuf^[0]) OF
  1212.          'T': CASE CHR (RBuf^[1]) OF
  1213.               'D', 'U':;
  1214.              |'C': CommWrData (cr);
  1215.                    (* SendACK; maybe duplicate completion *)
  1216.                    ReleaseBufs;
  1217.                    RETURN;
  1218.               ELSE StatusMessage ('Unimplemented transfer function', TRUE);
  1219.                    SendFailure ('NUnimplemented transfer function');
  1220.                    ReleaseBufs;
  1221.                    RETURN;
  1222.               END;
  1223.               CASE CHR (RBuf^[2]) OF
  1224.                    'A': FileType := ' (ASCII)';|
  1225.                    'B': FileType := ' (Binary)';|
  1226.                    ELSE
  1227.                        StatusMessage ('Unimplemented file type', TRUE);
  1228.                        SendFailure ('NUnimplemented file type');
  1229.                        ReleaseBufs;
  1230.                        RETURN;
  1231.               END;
  1232.               Len := 3;
  1233.               WHILE (RBuf^[Len] <> 0) AND (Len < RSize ) DO
  1234.                    INC(Len)
  1235.               END;
  1236.               DEC(Len, 3);  (* length of name *)
  1237.               Move ( ADR(RBuf^[3]), ADR ( FileName ), Len );
  1238.               IF Len < SIZE(FileName) THEN
  1239.                    FileName[Len] := 0C
  1240.               END;
  1241.               ChoosePath(FileName); (* DIAG: FIX NEEDED TO USE DOWNLOAD PATH *)
  1242.               TurnDisplayOn( FileName, CHR(RBuf^[1]) IN CHARSET{'D', 'R'} );
  1243.               IF (RBuf^[1] = SHORTCARD('U')) THEN
  1244.                   SendFile (FileName)
  1245.               ELSE
  1246.                   ReceiveFile (FileName)
  1247.               END;
  1248.               ShowTransferTime;
  1249.               StopDisplay;
  1250.         |'N': IF (CHR(RBuf^[1]) = 'G') AND  (* May be GIF *)
  1251.                  (CHR(RBuf^[2]) = 'I') AND
  1252.                  (CHR(RBuf^[3]) = 'F') THEN
  1253.                    FileType := '    (GIF)';
  1254.                    TurnDisplayOn( GifTempName, TRUE );
  1255.                    ReceiveGIF;
  1256.                    StopDisplay;
  1257.                    RETURN
  1258.               ELSE
  1259.                    SendFailure ('NUnknown packet type');
  1260.               END;
  1261.         |'+': DoTransportParameters;
  1262.         |'F': ShowFailure;
  1263.          ELSE SendFailure ('NUnknown packet type');
  1264.         END;  (* CASE *)
  1265.       END;    (* IF ReadPacket *)
  1266.       ReleaseBufs;
  1267.  
  1268. END DleBSeen;
  1269.  
  1270. BEGIN (* Unit Initialization *)
  1271.   AutoResume := FALSE;
  1272.   SpecialQuoting := FALSE;
  1273.   SpecialQuoteSet := DQextended;
  1274.   UpdChk := DoBCks;
  1275.   UseCRC := FALSE;
  1276.   chkInit := 0;
  1277.   AbortMax := 4;
  1278.   DefPtr := ADR(Def);
  1279. END QCbplus.
  1280.